home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / xlisp-1.6 / simplepp.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1991-10-06  |  3.5 KB  |  89 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         simplepp.lsp
  5. ; RCS:          $Header: $
  6. ; Description:  a pretty-printer, with hooks for the editor
  7. ; Author:       ???
  8. ; Created:      Sat Oct  5 21:03:25 1991
  9. ; Modified:     Sat Oct  5 21:03:40 1991 (Niels Mayer) mayer@hplnpm
  10. ; Language:     Lisp
  11. ; Package:      N/A
  12. ; Status:       X11r5 contrib tape release
  13. ;
  14. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. ;
  17. ; Permission to use, copy, modify, distribute, and sell this software and its
  18. ; documentation for any purpose is hereby granted without fee, provided that
  19. ; the above copyright notice appear in all copies and that both that
  20. ; copyright notice and this permission notice appear in supporting
  21. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  22. ; used in advertising or publicity pertaining to distribution of the software
  23. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  24. ; makes no representations about the suitability of this software for any
  25. ; purpose.  It is provided "as is" without express or implied warranty.
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27.  
  28. ; First, the terminal width and things to manipulate it
  29. (setq pp$terminal-width 79)
  30.  
  31. (defmacro get-terminal-width nil
  32.   pp$terminal_width)
  33.  
  34. (defmacro set-terminal-width (new-width)
  35.   (let ((old-width pp$terminal-width))
  36.     (setq pp$terminal-width new-width)
  37.     old-width))
  38. ;
  39. ; Now, a basic, simple pretty-printer
  40. ; pp$pp prints expression, indented to indent-level, assuming that things
  41. ; have already been indented to indent-so-far. It *NEVER* leaves the cursor
  42. ; on a new line after printing expression. This is to make the recursion
  43. ; simpler. This may change in the future, in which case pp$pp could vanish.
  44. ;
  45. (defun pp$pp (expression indent-level indent-so-far)
  46. ; Step one, make sure we've indented to indent-level
  47.   (dotimes (x (- indent-level indent-so-far)) (princ " "))
  48. ; Step two, if it's an atom or it fits just print it
  49.   (cond ((or (not (consp expression))
  50.          (> (- pp$terminal-width indent-level) (flatsize expression)))
  51.      (prin1 expression))
  52. ; else, print open paren, the car, then each sub expression, then close paren
  53.     (t (princ "(")
  54.        (pp$pp (car expression) (1+ indent-level) (1+ indent-level))
  55.        (if (cadr expression)
  56.            (progn
  57.          (if (or (consp (car expression))
  58.              (> (/ (flatsize (car expression)) 3)
  59.                 pp$terminal-width))
  60.              (progn (terpri)
  61.                 (pp$pp (cadr expression) 
  62.                    (1+ indent-level)
  63.                    0))
  64.              (pp$pp (cadr expression)
  65.                 (+ 2 indent-level (flatsize (car expression)))
  66.                 (+ 1 indent-level (flatsize (car expression)))))
  67.          (dolist (current-expression (cddr expression))
  68.              (terpri)
  69.              (pp$pp current-expression
  70.                 (+ 2 indent-level 
  71.                    (flatsize (car expression)))
  72.                 0))))
  73.        (princ ")")))
  74.   nil)
  75. ;
  76. ; Now, the thing that outside users should call
  77. ; We have to have an interface layer to get the final terpri after pp$pp.
  78. ; This also allows hiding the second and third args to pp$pp. Said args
  79. ; being required makes the pp recursion loop run faster (don't have to map
  80. ; nil's to 0).
  81. ;    The where arg to pp is ingnored, as the obvious hack to pp$pp [adding
  82. ; an extra arg to every call to a print routine or pp$pp] doesn't work,
  83. ; printing nothing when where is nil.
  84. ;
  85. (defun pp (expression &optional where)
  86. "Print EXPRESSION on STREAM, prettily"
  87.   (pp$pp expression 0 0)
  88.   (terpri))
  89.